C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C ----------------------------------------------------------------------
C
C       T Y P E S   -   Find type of current statement beginning at the
C                       specified token.
C
 
        SUBROUTINE TYPES(ITOKA,ITYPEA,NTOKA,NTOK2A)
        INTEGER ITOKA,ITYPEA,NTOKA,NTOK2A
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
*$AS$ (ITOKA.LE.2 .OR. ITYPEG.EQ.KLIFG)
        ITYPEA=KNONEG
        NTOKA=ITOKA
        IF (ITOKA.EQ.1 .AND. TOKTYP(1).EQ.TDCNST) NTOKA=2
        NTOK2A=NTOKSS
        ITYPEA=KTOKG(TOKTYP(NTOKA))
        NTOKA=NTOKA+1
C Verify initially assigned type code
        IF (ITYPEA.EQ.KCHARG .OR. ITYPEA.EQ.KINTEG .OR.
     +      ITYPEA.EQ.KREALG .OR. ITYPEA.EQ.KDBLEG .OR.
     +      ITYPEA.EQ.KLOGCG .OR. ITYPEA.EQ.KCMPXG) THEN
C Check for typed functions
            CALL VTYPES(ITYPEA,NTOKA)
        ELSE IF (ITYPEA.EQ.KUGOG) THEN
C Initial type = GOTO
            CALL VGOS(ITYPEA,NTOKA)
        ELSE IF (ITYPEA.EQ.KLIFG) THEN
C Initial type = IF
            CALL VIFS(ITYPEA,NTOKA,NTOK2A)
        END IF
C Check for statement functions
        IF (ITYPEA.EQ.KASMTG .AND. ITOKA.LE.2)
     +      CALL VASMTS(ITYPEA,NTOKA)
 
        END
C ----------------------------------------------------------------------
C
C       V A S T M T S   -   Verify type of assignment statement
C
 
        SUBROUTINE VASMTS(ITYPEA,NTOKA)
        INTEGER ITYPEA,NTOKA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Dictionary
C   MAXDDG = Maximum number of dimension names in dictionary
C   MAXRDG = Maximum number of routine names in dictionary
        INTEGER MAXDDG,MAXRDG
        PARAMETER(MAXDDG=150,MAXRDG=250)
        COMMON /ANDICT/ DDICTG,RDICTG
        CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
        SAVE /ANDICT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER ITOK,LOCL
        CHARACTER*6 NAMEL
 
        INTEGER NFINDF
        CHARACTER*6 NAME
 
C Look for parenthetical group to left of '='
        ITOK=NTOKA
        IF (TOKTYP(ITOK).EQ.TLPARN) THEN
C '(' found. Ensure not character substring expression.
 100        ITOK=ITOK+1
            IF (TOKTYP(ITOK).EQ.TCOLON) RETURN
            IF (TOKTYP(ITOK).NE.TEQUAL) GOTO 100
C Pick up variable/functionname to left of '='
            NAMEL=NAME(NTOKA-1)
            IF (NAMEL.NE.' ') THEN
                IF (NFINDF(NAMEL,DDICTG,NDDICG).EQ.0) THEN
C This is a statement function
                    ITYPEA = KSFUNG
C Save function name to avoid later recognition of function use as
C external function use.
                    CALL NSAVES(NAMEL,DDICTG,NDDICG,MAXDDG,LOCL)
                    IF (LOCL.EQ.0) CALL ERRORS(13)
                END IF
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       V T Y P E S   -   Verify type of type statement (may be function
C
        SUBROUTINE VTYPES(ITYPEA,NTOKA)
        INTEGER ITYPEA,NTOKA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
 
        INTEGER ITOK
 
        ITOK=NTOKA-1
 100    ITOK=ITOK+1
        IF (TOKTYP(ITOK).NE.TFUNCT .AND. ITOK.LT.NTOKSS) GOTO 100
        IF (TOKTYP(ITOK).EQ.TFUNCT) THEN
            IF (ITYPEA.EQ.KCHARG) ITYPEA=KCFUNG
            IF (ITYPEA.EQ.KLOGCG) ITYPEA=KLFUNG
            IF (ITYPEA.EQ.KREALG) ITYPEA=KRFUNG
            IF (ITYPEA.EQ.KDBLEG) ITYPEA=KDFUNG
            IF (ITYPEA.EQ.KINTEG) ITYPEA=KIFUNG
            IF (ITYPEA.EQ.KCMPXG) ITYPEA=KXFUNG
            NTOKA=ITOK+1
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       V G O S   -   Verify type of GOTO statement
C
 
        SUBROUTINE VGOS(ITYPEA,NTOKA)
        INTEGER ITYPEA,NTOKA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
 
        IF (TOKTYP(NTOKA).EQ.TLPARN) THEN
            ITYPEA=KCGOG
        ELSE IF (TOKTYP(NTOKA).EQ.TNAME) THEN
            ITYPEA=KAGOG
        ELSE
            ITYPEA=KUGOG
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       V I F S   -   Verify type of IF statement
C
 
        SUBROUTINE VIFS(ITYPEA,NTOKA,NTOK2A)
        INTEGER ITYPEA,NTOKA,NTOK2A
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
 
        INTEGER ITOK
 
C Balance parentheses
        CALL BALPRT(NTOKA,ITOK)
        IF (ITOK.GT.NTOKA .AND. ITOK.LT.NTOKSS) THEN
            NTOK2A=ITOK
            IF (TOKTYP(ITOK+1).EQ.TTHEN) THEN
                ITYPEA=KBIFG
            ELSE IF (TOKTYP(ITOK+1).EQ.TDCNST) THEN
                ITYPEA=KAIFG
            ELSE
                ITYPEA=KLIFG
            END IF
        ELSE
C Parentheses unbalanced
            CALL ERRORS(12)
            ITYPEA=KNONEG
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       W A R T H S   -   Insert arithmetic-IF function instrumentation
C
 
        SUBROUTINE WARTHS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        EXTERNAL ZMESS
 
*$AS$ (ARITHG)
        CALL ZMESS('      DOUBLE PRECISION FUNCTION A'//VNAMEG//
     +              '(DVALUE,ISEG)',IODINS)
        IF (.NOT.TRACEG) CALL WCOMNS
        CALL ZMESS('      DOUBLE PRECISION DVALUE',IODINS)
        CALL ZMESS('      INTEGER ISEG',IODINS)
        CALL ZMESS('      IF (DVALUE) 100,110,120',IODINS)
        IF (TRACEG) THEN
            CALL ZMESS(' 100  CALL T'//VNAMEG//'(ISEG)',IODINS)
        ELSE
            CALL ZMESS(' 100  I'//VNAMEG//'(ISEG)=I'//VNAMEG//
     +                  '(ISEG)+1',IODINS)
        END IF
        CALL ZMESS('      GOTO 130',IODINS)
        IF (TRACEG) THEN
            CALL ZMESS(' 110  CALL T'//VNAMEG//'(ISEG+1)',IODINS)
        ELSE
            CALL ZMESS(' 110  I'//VNAMEG//'(ISEG+1)=I'//VNAMEG//
     +                  '(ISEG+1)+1',IODINS)
        END IF
        CALL ZMESS('      GOTO 130',IODINS)
        IF (TRACEG) THEN
            CALL ZMESS(' 120  CALL T'//VNAMEG//'(ISEG+2)',IODINS)
        ELSE
            CALL ZMESS(' 120  I'//VNAMEG//'(ISEG+2)=I'//VNAMEG//
     +                  '(ISEG+2)+1',IODINS)
        END IF
        CALL ZMESS(' 130  A'//VNAMEG//'=DVALUE',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W A S R T S   -   Insert assertion monitoring routine
C                         instrumentation
C
 
        SUBROUTINE WASRTS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        EXTERNAL ZMESS
 
*$AS$ (ASSRTG)
        CALL ZMESS('      SUBROUTINE M'//VNAMEG//'(LVALUE,NUMBER)',
     +              IODINS)
        CALL WCOMNS
        CALL ZMESS('      LOGICAL LVALUE',IODINS)
        CALL ZMESS('      INTEGER NUMBER',IODINS)
        CALL ZMESS('      IF(..NOT..LVALUE) J'//VNAMEG//'(NUMBER)=J'//
     +              VNAMEG//'(NUMBER)+1',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W B L O K S   -   Insert BLOCK DATA instrumentation
C
 
        SUBROUTINE WBLOKS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        EXTERNAL ZMESS,ZCHOUT,ZPTINT
 
        CALL ZMESS('      BLOCK DATA B'//VNAMEG,IODINS)
        CALL WCOMNS
        CALL ZCHOUT('      DATA I'//VNAMEG//'/',IODINS)
        CALL ZPTINT(NMSEG,1,IODINS)
        CALL ZMESS('*0/',IODINS)
        IF (ASSRTG) THEN
            CALL ZCHOUT('      DATA J'//VNAMEG//'/',IODINS)
            CALL ZPTINT(NMASRG,1,IODINS)
            CALL ZMESS('*0/',IODINS)
        END IF
        IF (ENTRYG) CALL ZMESS('      DATA N'//VNAMEG//'/0/',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W C O M N S   -   Insert COMMON block instrumentation
C
 
        SUBROUTINE WCOMNS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        EXTERNAL ZMESS,ZCHOUT,ZPTINT
 
        IF (ASSRTG) THEN
            IF (ENTRYG) THEN
C Segment and assertion arrays and entry flag
                CALL ZCHOUT('      COMMON /C'//VNAMEG//'/I'//VNAMEG//
     +                  '(',IODINS)
                CALL ZPTINT(NMSEG,1,IODINS)
                CALL ZCHOUT('),J(',IODINS)
                CALL ZPTINT(NMASRG,1,IODINS)
                CALL ZMESS('),N'//VNAMEG,IODINS)
                CALL ZMESS('      INTEGER I'//VNAMEG//',J'//VNAMEG//
     +                  ',N'//VNAMEG,IODINS)
            ELSE
C Segment and assertion arrays
                CALL ZCHOUT('      COMMON/C'//VNAMEG//'/I'//VNAMEG//'(',
     +                     IODINS)
                CALL ZPTINT(NMSEG,1,IODINS)
                CALL ZCHOUT('),J'//VNAMEG//'(',IODINS)
                CALL ZPTINT(NMASRG,1,IODINS)
                CALL ZMESS(')',IODINS)
                CALL ZMESS('      INTEGER I'//VNAMEG//',J'//VNAMEG,
     +                      IODINS)
            END IF
        ELSE
            IF (ENTRYG) THEN
C Segment array and entry flag
                CALL ZMESS('      COMMON/C'//VNAMEG//'/I'//VNAMEG//',N'
     +                      //VNAMEG,IODINS)
                CALL ZCHOUT('      INTEGER I'//VNAMEG//'(',IODINS)
                CALL ZPTINT(NMSEG,1,IODINS)
                CALL ZMESS('),N'//VNAMEG,IODINS)
            ELSE
C Segment array
                CALL ZMESS('      COMMON/C'//VNAMEG//'/I'//VNAMEG,
     +                      IODINS)
                CALL ZCHOUT('      INTEGER I'//VNAMEG//'(',IODINS)
                CALL ZPTINT(NMSEG,1,IODINS)
                CALL ZMESS(')',IODINS)
            END IF
        END IF
C Save common block
        CALL ZMESS('      SAVE /C'//VNAMEG//'/',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W F N   -   Write filename declaration to instrumented program
C
 
        SUBROUTINE WFN2(FN,NAME,FN2,NAME2)
        CHARACTER*6 NAME,NAME2
        CHARACTER*(*) FN,FN2
 
        INTEGER FLEN,FLEN2
        LOGICAL TWO
 
        TWO=.TRUE.
        GOTO 100
 
        ENTRY WFN(FN,NAME)
        TWO=.FALSE.
 
 100    CALL WFNA(FN,NAME,FLEN)
        IF (TWO) CALL WFNA(FN2,NAME2,FLEN2)
        CALL WFNB(FN,NAME,FLEN)
        IF (TWO) CALL WFNB(FN2,NAME2,FLEN2)
 
        END
C ----------------------------------------------------------------------
C
C       W F N A   -   Output filename declaration part A
C
 
        SUBROUTINE WFNA(FN,NAME,FLEN)
        CHARACTER*6 NAME
        CHARACTER*(*) FN
        INTEGER FLEN
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
 
        INTEGER STRIPL
 
        EXTERNAL ZCHOUT,ZMESS,ZPTINT
 
        IF (FN.NE.' ') THEN
            IF (FN.EQ.'''') THEN
                FLEN=81
            ELSE
                FLEN=STRIPL(FN)
            END IF
            IF (TIEG) THEN
                CALL ZCHOUT('      INTEGER '//NAME//'(',IODINS)
                CALL ZPTINT(FLEN+1,1,IODINS)
                CALL ZMESS(')',IODINS)
            ELSE
                CALL ZCHOUT('      CHARACTER*',IODINS)
                CALL ZPTINT(FLEN,1,IODINS)
                CALL ZMESS(NAME,IODINS)
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       W F N B   -   Output filename declaration part B
C
 
        SUBROUTINE WFNB(FN,NAME,FLEN)
        CHARACTER*6 NAME
        CHARACTER*(*) FN
        INTEGER FLEN
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
 
        CHARACTER X
        INTEGER IFN(134),I
 
        EXTERNAL ZCHOUT,ZPTINT,ZMESS
 
        IF (FN.NE.'''' .AND. FN.NE.' ') THEN
            IF (TIEG) THEN
                CALL ZFTOI(FN,1,FLEN,IFN,.FALSE.)
                DO 100 I=1,FLEN+1
                    CALL ZCHOUT('      DATA '//NAME//'(',IODINS)
                    CALL ZPTINT(I,1,IODINS)
                    CALL ZCHOUT(')/',IODINS)
                    CALL ZPTINT(IFN(I),1,IODINS)
                    CALL ZMESS('/',IODINS)
 100            CONTINUE
            ELSE
                DO 200 I=1,FLEN
                    CALL ZCHOUT('      DATA '//NAME//'(',IODINS)
                    CALL ZPTINT(I,1,IODINS)
                    CALL ZCHOUT(':',IODINS)
                    CALL ZPTINT(I,1,IODINS)
                    X=FN(I:I)
                    CALL OUTMSG(')/'''//X//'''/',IODINS)
 200            CONTINUE
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       W G O T O S   -   Insert computed GOTO function instrumentation
C
 
        SUBROUTINE WGOTOS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        EXTERNAL ZMESS
 
*$AS$ (CGOTOG)
        CALL ZMESS('      INTEGER FUNCTION K'//VNAMEG//
     +              '(IVALUE,ISEG,NUMARG)',IODINS)
        CALL ZMESS('      INTEGER IVALUE,ISEG,NUMARG',IODINS)
        IF (.NOT.TRACEG) CALL WCOMNS
        CALL OUTMSG('      IF (IVALUE.GE.1 .AND. IVALUE.LE.NUMARG)',
     +              IODINS)
        IF (TRACEG) THEN
            CALL ZMESS('     *CALL T'//VNAMEG//'(ISEG+IVALUE)',IODINS)
        ELSE
            CALL ZMESS('     *I'//VNAMEG//'(ISEG+IVALUE)=I'//VNAMEG//
     +                  '(ISEG+IVALUE)+1',IODINS)
        END IF
        CALL ZMESS('      K'//VNAMEG//'=IVALUE',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W H I N S   -  Insert history file input routine instrumentation
C
 
        SUBROUTINE WHINS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Filenames
        COMMON/ANFNAM/IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        CHARACTER*81 IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        SAVE /ANFNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        EXTERNAL ZMESS
 
*$AS$ (HISTG)
        CALL ZMESS('      SUBROUTINE P'//VNAMEG//
     +              '(IARY,IDIM,IEOF,INHST,OPENED)',IODINS)
        CALL ZMESS('      INTEGER IDIM,IARY(IDIM),IHIST(16),I,INHST,'//
     +             'NUM,IEOF',IODINS)
        CALL ZMESS('      LOGICAL OPENED',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      INTEGER GETCH,CTOI,BUFF(134)',IODINS)
            CALL ZMESS('      INTEGER OPEN,CREATE,ZGTCMD',IODINS)
        END IF
        CALL WFN(IHSTFN,'IHSTFN')
C For assertion processing: don't open file if already open
        IF (ASSRTG) CALL ZMESS('      IF (OPENED) GOTO 99',IODINS)
C Ask for filename if required
        IF (IHSTFN.EQ.'''') THEN
            IF (TIEG) THEN
                CALL ZMESS('      CALL ZMESS(''Enter history input '//
     +                      'filename:'',1)',IODINS)
                CALL ZMESS('      JUNK=ZGTCMD(IHSTFN,0)',IODINS)
            ELSE
                CALL ZMESS('      PRINT *,''Enter history input '//
     +                      'filename''',IODINS)
                CALL ZMESS('      READ (*,23)IHSTFN',IODINS)
                CALL ZMESS(' 23   FORMAT(A)',IODINS)
            END IF
        END IF
        CALL ZMESS('      IEOF=1',IODINS)
        IF (IHSTFN.NE.' ') THEN
            IF (TIEG) THEN
                IF (INHSTG.EQ.ITHSTG .AND. OHSTFN.EQ.' ') THEN
                    CALL ZMESS('      INHST=OPEN(IHSTFN,2)',
     +                          IODINS)
                    CALL ZMESS('      IF (INHST..EQ..-1) THEN',IODINS)
                    CALL ZMESS('      INHST=CREATE(IHSTFN,'//
     +                          '2)',IODINS)
                    CALL ZMESS('      RETURN',IODINS)
                    CALL ZMESS('      END IF',IODINS)
                ELSE
                    CALL ZMESS('      INHST=OPEN(IHSTFN,0)',IODINS)
                    CALL OUTMSG('      IF (INHST.EQ.-1) RETURN',IODINS)
                END IF
            ELSE
                IF (INHSTG.EQ.ITHSTG .AND. OHSTFN.EQ.' ') THEN
                    CALL ZMESS('      OPEN(INHST,FILE=IHSTFN,'//
     +                          'STATUS=''UNKNOWN'',ERR=130)',IODINS)
                ELSE
                    CALL ZMESS('      OPEN(INHST,FILE=IHSTFN,'//
     +                          'STATUS=''OLD'',ERR=130)',IODINS)
                END IF
                CALL ZMESS('      REWIND(INHST,ERR=130)',IODINS)
            END IF
        END IF
        IF (TIEG) THEN
            CALL ZMESS('  99  JUNK=ZGTCMD(BUFF,INHST)',IODINS)
            CALL ZMESS('      JUNK=1',IODINS)
            CALL ZMESS('      IF (CTOI(BUFF,JUNK)..NE..IDIM)',IODINS)
            CALL ZMESS('     +CALL ERROR(''WRONG HISTORY FILE'')',
     +                  IODINS)
            CALL ZMESS('      NUM=0',IODINS)
            CALL ZMESS(' 100  DO 105 I=1,16',IODINS)
            CALL ZMESS('      CALL READF(BUFF,8,INHST)',IODINS)
            CALL ZMESS('      JUNK=1',IODINS)
            CALL ZMESS('      IHIST(I)=CTOI(BUFF,JUNK)',IODINS)
            CALL ZMESS(' 105  CONTINUE',IODINS)
            CALL ZMESS('      JUNK=GETCH(JUNK,INHST)',IODINS)
        ELSE
            CALL ZMESS('  99  READ(INHST,9010,END=130,ERR=130) NUM',
     +                  IODINS)
            CALL ZMESS('      IF(NUM..NE..IDIM)THEN',IODINS)
            CALL ZMESS('      PRINT *,''WRONG HISTORY FILE''',IODINS)
            CALL ZMESS('      STOP ''ERROR ABORT''',IODINS)
            CALL ZMESS('      END IF',IODINS)
            CALL ZMESS('      NUM=0',IODINS)
            CALL ZMESS(' 100  READ(INHST,9010,END=130,ERR=130) IHIST',
     +                  IODINS)
        END IF
        CALL ZMESS('      DO 110 I=1,16',IODINS)
        CALL ZMESS('      NUM=NUM+1',IODINS)
        CALL ZMESS('      IF (NUM..GT..IDIM) GOTO 120',IODINS)
        CALL ZMESS(' 110  IARY(NUM)=IARY(NUM)+IHIST(I)',IODINS)
        CALL ZMESS('      IF (NUM..LT..IDIM) GOTO 100',IODINS)
        CALL ZMESS(' 120  IEOF=0',IODINS)
        CALL ZMESS(' 130  CONTINUE',IODINS)
        IF (.NOT.TIEG) THEN
            CALL ZMESS(' 9000 FORMAT(I8)',IODINS)
            CALL ZMESS(' 9010 FORMAT(16I8)',IODINS)
        END IF
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W H O U T S   -   INSERT HISTORY FILE OUTPUT ROUTINE
C                         INSTRUMENTATION
C
 
        SUBROUTINE WHOUTS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Filenames
        COMMON/ANFNAM/IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        CHARACTER*81 IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        SAVE /ANFNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        LOGICAL RUNF
 
        CALL ZMESS('      SUBROUTINE O'//VNAMEG//
     +              '(IARY,IDIM,ITHST,RUNF)',IODINS)
        CALL ZMESS('      INTEGER IDIM,IARY(IDIM),IHIST(16),ITHST,'//
     +             'NUM,I,L',IODINS)
        CALL ZMESS('      LOGICAL FTF,RUNF',IODINS)
        CALL ZMESS('      SAVE',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CHARACTER*128 LINE',IODINS)
            CALL ZMESS('      INTEGER OPEN,CREATE,ZGTCMD',IODINS)
        END IF
        RUNF=(ITRUNG.NE.0 .OR. RUNFN.NE.' ')
*$AS$ (HISTG .OR. RUNF)
        IF (RUNF) THEN
            CALL ZMESS('      LOGICAL RUNFTF',IODINS)
            IF (HISTG) THEN
                CALL WFN2(OHSTFN,'OHSTFN',RUNFN,'RUNFN ')
            ELSE
                CALL WFN(RUNFN,'RUNFN ')
            END IF
            CALL ZMESS('      DATA RUNFTF/..TRUE../',IODINS)
        ELSE
            CALL WFN(OHSTFN,'OHSTFN')
        END IF
        CALL ZMESS('      DATA FTF/..TRUE../',IODINS)
        IF (RUNF) THEN
            CALL ZMESS('      IF (RUNF ..AND.. RUNFTF) THEN',IODINS)
            IF (RUNFN.EQ.'''') THEN
                IF (TIEG) THEN
                    CALL ZMESS('      CALL ZMESS(''Enter run data '//
     +                          'filename:'',1)',IODINS)
                    CALL ZMESS('      JUNK=ZGTCMD(RUNFN,0)',IODINS)
                ELSE
                    CALL ZMESS('      PRINT *,''Enter run data '//
     +                          'filename''',IODINS)
                    CALL ZMESS('      READ (*,23) RUNFN',IODINS)
                    CALL ZMESS(' 23   FORMAT(A)',IODINS)
                END IF
            END IF
            IF (TIEG .AND. RUNFN.NE.' ') THEN
                CALL ZMESS('      ITHST=CREATE(RUNFN,1)',IODINS)
                CALL ZMESS('      IF (ITHST..EQ..-1) RETURN',IODINS)
            ELSE IF (RUNFN.NE.' ') THEN
                CALL ZMESS('      OPEN(ITHST,FILE=RUNFN,STATUS='''//
     +                      'UNKNOWN'',ERR=140)',IODINS)
                CALL ZMESS('      REWIND(ITHST,ERR=16)',IODINS)
                CALL ZMESS('   16 CONTINUE',IODINS)
            END IF
            CALL ZMESS('      RUNFTF=..FALSE..',IODINS)
            CALL ZMESS('      END IF',IODINS)
        END IF
        CALL ZMESS('      IF (FTF ..AND.. ..NOT..RUNF) THEN',IODINS)
        IF (OHSTFN.EQ.'''') THEN
            IF (TIEG) THEN
                CALL ZMESS('      CALL ZMESS(''Enter history output '//
     +                     'filename:'',1)',IODINS)
                CALL ZMESS('      JUNK=ZGTCMD(OHSTFN,0)',IODINS)
            ELSE
                CALL ZMESS('      PRINT *,''Enter history output '//
     +                     'filename''',IODINS)
                CALL ZMESS('      READ (*,24) OHSTFN',IODINS)
                CALL ZMESS(' 24   FORMAT(A)',IODINS)
            END IF
        END IF
        IF (HISTG .AND. OHSTFN.EQ.' ') THEN
            IF (TIEG) CALL ZMESS('      CALL SEEK(0,ITHST)',IODINS)
        ELSE IF (HISTG) THEN
            IF (TIEG) THEN
                CALL ZMESS('      ITHST=CREATE(OHSTFN,1)',IODINS)
                CALL ZMESS('      IF (ITHST..EQ..-1) RETURN',IODINS)
            ELSE
                CALL ZMESS('      OPEN(ITHST,FILE=OHSTFN,STATUS='''//
     +                      'UNKNOWN'',ERR=140)',IODINS)
            END IF
        END IF
        IF (HISTG .AND..NOT. TIEG) THEN
            CALL ZMESS('      REWIND(ITHST,ERR=17)',IODINS)
            CALL ZMESS(' 17   CONTINUE',IODINS)
        END IF
        CALL ZMESS('      FTF=..FALSE..',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      NUM=0',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CALL ZPTINT(IDIM,8,ITHST)',IODINS)
            CALL ZMESS('      CALL PUTCH(10,ITHST)',IODINS)
        ELSE
            CALL ZMESS('      WRITE(ITHST,9000)IDIM',IODINS)
        END IF
        CALL ZMESS('      DO 100 L=1,IDIM',IODINS)
        CALL ZMESS('      NUM=NUM+1',IODINS)
        CALL ZMESS('      IHIST(NUM)=IARY(L)',IODINS)
        CALL ZMESS('      IF (NUM..EQ..16..OR..L..EQ..IDIM)THEN',
     +              IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      WRITE(LINE,9010) (IHIST(I),I=1,NUM)',
     +                  IODINS)
            CALL ZMESS('      CALL ZMESS(LINE,ITHST)',IODINS)
        ELSE
            CALL ZMESS('      WRITE(ITHST,9010) (IHIST(I),I=1,NUM)',
     +                  IODINS)
        END IF
        CALL ZMESS('      NUM=0',IODINS)
        CALL ZMESS('      ENDIF',IODINS)
        CALL ZMESS(' 100  CONTINUE',IODINS)
        CALL ZMESS(' 140  RETURN',IODINS)
        CALL ZMESS(' 9000 FORMAT(I8)',IODINS)
        CALL ZMESS(' 9010 FORMAT(16I8..8)',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W I F D O S   -   Insert logical function instrumentation
C
 
        SUBROUTINE WIFDOS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        EXTERNAL ZMESS
 
*$AS$ (IFDOG)
        CALL ZMESS('      LOGICAL FUNCTION L'//VNAMEG//
     +              '(LVALUE,ISEG,JSEG)',IODINS)
        CALL ZMESS('      LOGICAL LVALUE',IODINS)
        CALL ZMESS('      INTEGER ISEG,JSEG',IODINS)
        IF (.NOT.TRACEG) CALL WCOMNS
        CALL ZMESS('      IF (ISEG..NE..0)',IODINS)
        IF (TRACEG) THEN
            CALL ZMESS('     + CALL T'//VNAMEG//'(ISEG)',IODINS)
        ELSE
            CALL ZMESS('     + I'//VNAMEG//'(ISEG)=I'//VNAMEG//
     +                  '(ISEG)+1',IODINS)
        END IF
        CALL ZMESS('      IF (LVALUE..AND..JSEG..NE..0)',IODINS)
        IF (TRACEG) THEN
            CALL ZMESS('     + CALL T'//VNAMEG//'(JSEG)',IODINS)
        ELSE
            CALL ZMESS('     + I'//VNAMEG//'(JSEG)=I'//VNAMEG//
     +                  '(JSEG)+1',IODINS)
        END IF
        CALL ZMESS('      L'//VNAMEG//'=LVALUE',IODINS)
        CALL ZMESS('      RETURN',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W L I N E S   -   Insert line control routine instrumentation
C
 
        SUBROUTINE WLINES
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        EXTERNAL ZCHOUT,ZPTINT,ZMESS
 
        CALL ZMESS('      SUBROUTINE Q'//VNAMEG//'(LINE,ITLST)',IODINS)
        CALL ZMESS('      INTEGER LINE,ITLST,I',IODINS)
        CALL ZMESS('      LINE=LINE+1',IODINS)
        CALL ZCHOUT('      IF (LINE..GT..',IODINS)
        CALL ZPTINT(50,1,IODINS)
        CALL ZMESS(')THEN',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CALL PUTCH(10,ITLST)',IODINS)
            CALL ZMESS('      CALL ZOBLNK(16,ITLST)',IODINS)
            CALL ZMESS('      CALL ZMESS(''0     1     2     3    ''//',
     +                  IODINS)
            CALL ZMESS('     +'' 4     5     6     7     8     9'','//
     +                  'ITLST)',IODINS)
        ELSE
            CALL ZMESS('      WRITE(ITLST,100) (I,I=1,9)',IODINS)
            CALL ZMESS(' 100  FORMAT(''1'',16X,''0'',9(5X,I1)/)',
     +                  IODINS)
        END IF
        CALL ZMESS('      LINE=5',IODINS)
        CALL ZMESS('      ENDIF',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W R A P S   -   Insert wrapup control routine instrumentation
C
 
        SUBROUTINE WRAPS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Filenames
        COMMON/ANFNAM/IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        CHARACTER*81 IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        SAVE /ANFNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
        INTEGER L,NDIML
        CHARACTER*5 NUMBER(3)
 
        EXTERNAL ZMESS,ZCHOUT,ZPTINT
 
        IF (TIEG) THEN
C Replacement for calls to ERROR
            CALL ZMESS('      SUBROUTINE E'//VNAMEG//'(S)',IODINS)
            CALL ZMESS('      CHARACTER*(*)S',IODINS)
            CALL ZMESS('      CALL REMARK(''USER PROGRAM HAS CALLED'//
     +                  '"ERROR"'')',IODINS)
            CALL ZMESS('      CALL REMARK(S)',IODINS)
            CALL ZMESS('      CALL R'//VNAMEG//'(-1)',IODINS)
            CALL ZMESS('      END',IODINS)
C Replacement for user's ZEXIT (cmd interpreters only)
C *** we always output this routine to save us remembering whether we came
C     across a call to ZEXIT or not. ***
C This will however not work unless the command interpreter calls ZQUIT
C to exit and not ZEXIT -- and the TIE implementation allows command
C interpreters to exit by using ZQUIT.
            CALL ZMESS('      SUBROUTINE W'//VNAMEG//'(I)',IODINS)
            CALL ZMESS('      INTEGER I',IODINS)
            CALL ZMESS('      EXTERNAL ZEXIT,ZINIT',IODINS)
            CALL ZMESS('      CALL ZEXIT(I)',IODINS)
            CALL ZMESS('      CALL ZINIT',IODINS)
            CALL ZMESS('      END',IODINS)
C Replacement for ZQUIT
            CALL ZMESS('      SUBROUTINE R'//VNAMEG//'(QUITV)',
     +                  IODINS)
            CALL ZMESS('      INTEGER QUITV',IODINS)
            CALL ZMESS('      INTEGER CREATE,ZGTCMD',IODINS)
        ELSE
            CALL ZMESS('      SUBROUTINE R'//VNAMEG,IODINS)
        END IF
C SPECIFICATION STATEMENTS
        CALL WCOMNS
        CALL ZMESS('      INTEGER ITLST,NUM,K,L,LINE',IODINS)
        NDIML = NRTNG + 1
        WRITE(NUMBER(1),9000) NDIML
        CALL ZMESS('      INTEGER IBEG('//NUMBER(1)//'),NOSEG(10)',
     +              IODINS)
        IF (HISTG) THEN
            CALL ZMESS('      INTEGER INHST,ITHST,IEOF',IODINS)
        END IF
        IF (RUNFN.NE.' ' .OR. ITRUNG.NE.0) THEN
            CALL ZMESS('      INTEGER ITRUN',IODINS)
        END IF
        IF (ASSRTG) THEN
            CALL ZMESS('      INTEGER JBEG('//NUMBER(1)//')',IODINS)
            CALL WFN(LSTFN,'LSTFN ')
            DO 100 L=1,NDIML
                WRITE(NUMBER(1),9000) L
                WRITE(NUMBER(2),9000) ISBEG(L)
                WRITE(NUMBER(3),9000) IABEG(L)
                CALL ZMESS('      DATA IBEG('//NUMBER(1)//'),JBEG('//
     +                      NUMBER(1)//')/'//NUMBER(2)//','//NUMBER(3)
     +                      //'/',IODINS)
 100        CONTINUE
        ELSE
            CALL WFN(LSTFN,'LSTFN ')
            DO 200 L=1,NDIML
                CALL ZCHOUT('      DATA IBEG(',IODINS)
                CALL ZPTINT(L,1,IODINS)
                CALL ZCHOUT(')/',IODINS)
                CALL ZPTINT(ISBEG(L),1,IODINS)
                CALL ZMESS('/',IODINS)
 200        CONTINUE
        END IF
        CALL ZCHOUT('      DATA ITLST/',IODINS)
        CALL ZPTINT(ITLSTG,1,IODINS)
        CALL ZMESS('/',IODINS)
        IF (HISTG) THEN
            CALL ZCHOUT('      DATA INHST,ITHST/',IODINS)
            CALL ZPTINT(INHSTG,1,IODINS)
            CALL ZCHOUT(',',IODINS)
            CALL ZPTINT(ITHSTG,1,IODINS)
            CALL ZMESS('/',IODINS)
        END IF
        IF (RUNFN.NE.' ' .OR. ITRUNG.NE.0) THEN
            CALL ZCHOUT('      DATA ITRUN/',IODINS)
            CALL ZPTINT(ITRUNG,1,IODINS)
            CALL ZMESS('/',IODINS)
        END IF
C EMPTY TRACE BUFFER, IF REQD
        IF (TRACEG) CALL ZMESS('      CALL V'//VNAMEG//
     +                          '(-1,''TRACE=     '')',IODINS)
C Open listing file
        IF (LSTFN.EQ.'''') THEN
            IF (TIEG) THEN
                CALL ZMESS('      CALL ZMESS(''Enter listing '//
     +                      'filename:'',1)',IODINS)
                CALL ZMESS('      JUNK=ZGTCMD(LSTFN,0)',IODINS)
            ELSE
                CALL ZMESS('      PRINT *,''Enter listing '//
     +                      'filename''',IODINS)
                CALL ZMESS('      READ *,LSTFN',IODINS)
            END IF
        END IF
        IF (LSTFN.NE.' ') THEN
            IF (TIEG) THEN
                CALL ZMESS('      ITLST=CREATE(LSTFN,1)',IODINS)
                CALL ZMESS('      IF (ITLST..EQ..-1) RETURN',IODINS)
            ELSE
                CALL ZMESS('      OPEN(ITLST,FILE=LSTFN,STATUS='''//
     +                      'UNKNOWN'')',IODINS)
            END IF
        END IF
C OUTPUT SEGMENT REPORT
        IF (TIEG) THEN
            CALL ZMESS('      CALL ZOBLNK(24,ITLST)',IODINS)
            CALL ZMESS('      CALL ZMESS(''SEGMENT EXECUTION FRE'//
     +                  'QUENCIES - CURRENT..'',ITLST)',IODINS)
            CALL ZMESS('      CALL PUTCH(10,ITLST)',IODINS)
            CALL ZMESS('      CALL ZOBLNK(17,ITLST)',IODINS)
            CALL ZMESS('      CALL ZMESS(''0     1     2  ''//',IODINS)
            CALL ZMESS('     +''   3     4     5     6     7     8'//
     +                  '     9'',ITLST)',IODINS)
            CALL ZMESS('      CALL PUTCH(10,ITLST)',IODINS)
        ELSE
            CALL ZMESS('      WRITE (ITLST,110)',IODINS)
            CALL ZMESS ('  110 FORMAT (''1'',24X,'//
     +            '''SEGMENT EXECUTION FREQUENCIES - CURRENT'')',IODINS)
            CALL ZMESS('      WRITE (ITLST,120) (L,L=1,9)',IODINS)
            CALL ZMESS ('  120 FORMAT (''0'',17X,''0'',9(5X,I1),/)',
     +                   IODINS)
        END IF
        WRITE(NUMBER(1),9000) NMSEG
        CALL ZMESS('      CALL S'//VNAMEG//'(I'//VNAMEG//','//
     +              NUMBER(1)//',IBEG,ITLST)',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CALL PUTCH(10,ITLST)',IODINS)
            CALL ZMESS('      CALL ZOBLNK(36,ITLST)',IODINS)
            CALL ZMESS('      CALL ZMESS(''SEGMENTS NOT EXECUTED'','//
     +                  'ITLST)',IODINS)
        ELSE
            CALL ZMESS('      WRITE (ITLST,130)',IODINS)
            CALL ZMESS ('  130 FORMAT (''1'',36X,'//
     +                   '''SEGMENTS NOT EXECUTED'',/)',IODINS)
        END IF
        CALL ZMESS('      LINE=2',IODINS)
        CALL ZMESS('      NUM=0',IODINS)
C OUTPUT SEGMENTS NOT EXECUTED
        CALL ZMESS('      DO 100 L=1,'//NUMBER(1),IODINS)
        CALL ZMESS('      IF (I'//VNAMEG//'(L)..EQ..0) THEN',IODINS)
        CALL ZMESS('      NUM=NUM+1',IODINS)
        CALL ZMESS('      NOSEG(NUM)=L',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      IF (NUM..EQ..10..OR..(L..EQ..'//NUMBER(1)//
     +              '..AND..NUM..GT..0))THEN',IODINS)
        CALL ZMESS('      CALL Q'//VNAMEG//'(LINE,ITLST)',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      DO 200 K=1,NUM',IODINS)
            CALL ZMESS('      CALL ZPTINT(NOSEG(K),7,ITLST)',
     +                  IODINS)
            CALL ZMESS('      IF(MOD(K,10)..EQ..0) CALL '//
     +                  'PUTCH(10,ITLST)',IODINS)
            CALL ZMESS(' 200  CONTINUE',IODINS)
        ELSE
            CALL ZMESS('      WRITE (ITLST,140) (NOSEG(K),K=1,NUM)',
     +                  IODINS)
            CALL ZMESS('  140 FORMAT (10(2X,I5))',IODINS)
        END IF
        CALL ZMESS('      NUM=0',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS(' 100  CONTINUE',IODINS)
C Convert number of assertions to a character string
        WRITE(NUMBER(2),9000) NMASRG
C Do single-run data if required
        IF (RUNFN.NE.' ' .OR. ITRUNG.NE.0) THEN
            CALL ZMESS('      CALL O'//VNAMEG//'(I'//VNAMEG//','//
     +                  NUMBER(1)//',ITRUN,..TRUE..)',IODINS)
C Single-run assertion data if required
            IF (ASSRTG) CALL ZMESS('      CALL O'//VNAMEG//'(J'//VNAMEG
     +                     //','//NUMBER(2)//',ITRUN,..TRUE..)',IODINS)
            IF (TIEG) THEN
                CALL ZMESS('      CALL CLOSE(ITRUN)',IODINS)
            ELSE
                CALL ZMESS('      CLOSE(ITRUN)',IODINS)
            END IF
        END IF
C Input old segment history, if required
        IF (HISTG) THEN
            CALL ZMESS('      CALL P'//VNAMEG//'(I'//VNAMEG//','//
     +                  NUMBER(1)//',IEOF,INHST,..FALSE..)',IODINS)
        END IF
C Output assertion report, if required
        IF (ASSRTG) THEN
            IF (TIEG) THEN
                CALL ZMESS('      CALL PUTCH(10,ITLST)',IODINS)
                CALL ZMESS('      CALL ZOBLNK(24,ITLST)',IODINS)
                CALL ZMESS('      CALL ZMESS(''ASSERTION FAILURE FRE'//
     +                      'QUENCIES - CURRENT'',ITLST)',IODINS)
                CALL ZMESS('      CALL PUTCH(10,ITLST)',IODINS)
                CALL ZMESS('      CALL ZOBLNK(17,ITLST)',IODINS)
                CALL ZMESS('      CALL ZMESS(''0     1    ''//',IODINS)
                CALL ZMESS('     +'' 2     3     4     5     6     7'//
     +                  '     8     9'',ITLST)',IODINS)
                CALL ZMESS('      CALL PUTCH(10,ITLST)',IODINS)
            ELSE
                CALL ZMESS('      WRITE (ITLST,150)',IODINS)
                CALL ZMESS ('  150 FORMAT (''1'',24X,'//
     +        '''ASSERTION FAILURE FREQUENCIES - CURRENT'')',IODINS)
                CALL ZMESS('      WRITE (ITLST,120) (L,L=1,9)',
     +                      IODINS)
            END IF
            CALL ZMESS('      CALL S'//VNAMEG//'(J'//VNAMEG//','//
     +                  NUMBER(1)//',JBEG,ITLST)',IODINS)
C Input old assertion history, if required
            IF (HISTG) THEN
                CALL ZMESS('      IF (IEOF..EQ..0) CALL P'//VNAMEG//
     +                             '(J'//VNAMEG//','//NUMBER(2)//
     +                             ',IEOF,INHST,..TRUE..)',IODINS)
            END IF
        END IF
        IF (HISTG) THEN
C Output new segment history, if required
            IF (ITHSTG.EQ.INHSTG) CALL ZMESS('      ITHST=INHST',
     +                                        IODINS)
            CALL ZMESS('      CALL O'//VNAMEG//'(I'//VNAMEG//','//
     +                  NUMBER(1)//',ITHST,..FALSE..)',IODINS)
C Output new assertion history, if required
            IF (ASSRTG) CALL ZMESS('      CALL O'//VNAMEG//'(J'//VNAMEG
     +                    //','//NUMBER(2)//',ITHST,..FALSE..)',IODINS)
            IF (TIEG) THEN
                CALL ZMESS('      CALL CLOSE(INHST)',IODINS)
                IF (INHSTG.NE.ITHSTG .OR. OHSTFN.NE.' ') CALL ZMESS(
     +              '      CALL CLOSE(ITHST)',IODINS)
            ELSE
                CALL ZMESS('      CLOSE(INHST)',IODINS)
                IF (INHSTG.NE.ITHSTG .OR. OHSTFN.NE.' ') CALL ZMESS(
     +              '      CLOSE(ITHST)',IODINS)
            END IF
        END IF
C Actually terminate the program.
        IF (TIEG) THEN
            CALL ZMESS ('      CALL ZQUIT(QUITV)',IODINS)
        ELSE
            CALL ZMESS ('      STOP',IODINS)
        END IF
        CALL ZMESS('      END',IODINS)
 
9000    FORMAT(SS,I5)
        END
C ----------------------------------------------------------------------
C
C       W R E P T S   -   Insert report-generation routine
C                         instrumentation
 
        SUBROUTINE WREPTS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Dictionary
C   MAXDDG = Maximum number of dimension names in dictionary
C   MAXRDG = Maximum number of routine names in dictionary
        INTEGER MAXDDG,MAXRDG
        PARAMETER(MAXDDG=150,MAXRDG=250)
        COMMON /ANDICT/ DDICTG,RDICTG
        CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
        SAVE /ANDICT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
        INTEGER L
        EXTERNAL ZCHOUT,ZMESS,ZPTINT,PUTCH
 
        CALL ZMESS('      SUBROUTINE S'//VNAMEG//
     +              '(IARY,IDIM,NBEG,ITLST)',IODINS)
        CALL ZCHOUT('      INTEGER IDIM,IARY(IDIM),NBEG(',IODINS)
        CALL ZPTINT(NRTNG+1,1,IODINS)
        CALL ZMESS('),JTENS,ITLST,I,J,K,L',IODINS)
        CALL ZMESS('      INTEGER ILOWER,IUPPER,JEND,JSTART,JUNITS,LINE'
     +            ,IODINS)
        CALL ZMESS('      CHARACTER*24 KOUT(10),LOUT',IODINS)
        CALL ZCHOUT('      CHARACTER*6 NAM(',IODINS)
        CALL ZPTINT(NRTNG,1,IODINS)
        CALL ZMESS(')',IODINS)
        IF (TIEG) CALL ZMESS('      CHARACTER*80 BUFFER',IODINS)
C Output report formats
        CALL ZMESS('      DATA KOUT',IODINS)
        CALL ZMESS('     */''(1X,I5,''''X'''',6X,10(1X,I5))''',IODINS)
        CALL ZMESS('     *,''(1X,I5,''''X'''',12X,9(1X,I5))''',IODINS)
        CALL ZMESS('     *,''(1X,I5,''''X'''',18X,8(1X,I5))''',IODINS)
        CALL ZMESS('     *,''(1X,I5,''''X'''',24X,7(1X,I5))''',IODINS)
        CALL ZMESS('     *,''(1X,I5,''''X'''',30X,6(1X,I5))''',IODINS)
        CALL ZMESS('     *,''(1X,I5,''''X'''',36X,5(1X,I5))''',IODINS)
        CALL ZMESS('     *,''(1X,I5,''''X'''',42X,4(1X,I5))''',IODINS)
        CALL ZMESS('     *,''(1X,I5,''''X'''',48X,3(1X,I5))''',IODINS)
        CALL ZMESS('     *,''(1X,I5,''''X'''',54X,2(1X,I5))''',IODINS)
        CALL ZMESS('     *,''(1X,I5,''''X'''',60X,1(1X,I5))''/',IODINS)
C User routine names
        DO 100 L=1,NRTNG
            CALL ZCHOUT('      DATA NAM(',IODINS)
            CALL ZPTINT(L,1,IODINS)
            CALL ZMESS(')/'''//RDICTG(ICRTNG(L))//''' /',IODINS)
  100   CONTINUE
C The program proper
        CALL ZMESS('      LINE=4',IODINS)
        CALL ZCHOUT('      DO 110 I=1,',IODINS)
        CALL ZPTINT(NRTNG,1,IODINS)
        CALL PUTCH(10,IODINS)
        CALL ZMESS('      ILOWER=NBEG(I)',IODINS)
        CALL ZMESS('      IUPPER=NBEG(I+1)-1',IODINS)
        CALL ZMESS('      IF (ILOWER..LE..IUPPER) THEN',IODINS)
        CALL ZMESS('      CALL Q'//VNAMEG//'(LINE,ITLST)',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CALL ZMESS(''       ''//NAM(I),ITLST)',
     +                  IODINS)
        ELSE
            CALL ZMESS('      WRITE (ITLST,120) NAM(I)',IODINS)
        END IF
        CALL ZMESS('      JSTART=ILOWER',IODINS)
        CALL ZMESS('      JTENS=ILOWER/10',IODINS)
        CALL ZMESS('      JUNITS=ILOWER - JTENS*10',IODINS)
        CALL ZMESS('      IF (JUNITS..GT..0) THEN',IODINS)
        CALL ZMESS('      JEND=JTENS*10 + 9',IODINS)
        CALL ZMESS('      LOUT=KOUT(JUNITS+1)',IODINS)
        CALL ZMESS('      CALL Q'//VNAMEG//'(LINE,ITLST)',IODINS)
        CALL ZMESS('      IF (JEND..LT..IUPPER) THEN',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      WRITE(BUFFER,LOUT) JTENS,'//
     +                  '(IARY(L),L=ILOWER,JEND)',IODINS)
            CALL ZMESS('      CALL ZMESS(BUFFER,ITLST)',IODINS)
            CALL ZMESS('      ELSE',IODINS)
            CALL ZMESS('      WRITE (BUFFER,LOUT) JTENS,'//
     +                  '(IARY(L),L=ILOWER,IUPPER)',IODINS)
            CALL ZMESS('      CALL ZMESS(BUFFER,ITLST)',IODINS)
        ELSE
            CALL ZMESS('      WRITE (ITLST,LOUT) JTENS,'//
     +                  '(IARY(L),L=ILOWER,JEND)',IODINS)
            CALL ZMESS('      ELSE',IODINS)
            CALL ZMESS('      WRITE (ITLST,LOUT) JTENS,'//
     +                  '(IARY(L),L=ILOWER,IUPPER)',IODINS)
        END IF
        CALL ZMESS('      GO TO 110',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      JSTART=JEND+1',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      LOUT=KOUT(1)',IODINS)
        CALL ZMESS('      DO 100 J=JSTART,IUPPER,10',IODINS)
        CALL ZMESS('      JTENS=J/10',IODINS)
        CALL ZMESS('      JEND=J+9',IODINS)
        CALL ZMESS('      IF (JEND..GT..IUPPER) JEND=IUPPER',IODINS)
        CALL ZMESS('      CALL Q'//VNAMEG//'(LINE,ITLST)',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      WRITE(BUFFER,LOUT) JTENS,'//
     +                  '(IARY(L),L=J,JEND)',IODINS)
            CALL ZMESS('  100 CALL ZMESS(BUFFER(1:72),ITLST)',IODINS)
        ELSE
            CALL ZMESS('  100 WRITE (ITLST,LOUT) JTENS,'//
     +                  '(IARY(L),L=J,JEND)',IODINS)
        END IF
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('  110 CONTINUE',IODINS)
        CALL ZMESS('      RETURN',IODINS)
        CALL ZMESS('  120 FORMAT (8X,A6)',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W T B U F S   -   Insert trace control routine instrumentation
C
 
        SUBROUTINE WTBUFS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
        EXTERNAL ZCHOUT,ZMESS,ZPTINT
 
*$AS$ (TRACEG)
        CALL ZMESS('      SUBROUTINE T'//VNAMEG//'(NSEG)',IODINS)
        CALL WCOMNS
        CALL TCOMNS
        CALL ZMESS('      SAVE ICIRCL,ICOUNT,IFIRST,IPT',IODINS)
        CALL ZCHOUT('      DIMENSION ICIRCL(',IODINS)
        CALL ZPTINT(MCIRCG,1,IODINS)
        CALL ZMESS(')',IODINS)
        CALL ZCHOUT('      DATA ICOUNT,IFIRST,IPT/0,1,',IODINS)
        CALL ZPTINT(MCIRCG,1,IODINS)
        CALL ZMESS('/',IODINS)
        CALL ZMESS('      I'//VNAMEG//'(NSEG)=I'//VNAMEG//'(NSEG)+1',
     +              IODINS)
        CALL ZMESS('      IF (IFIRST..EQ..1) THEN',IODINS)
        CALL ZMESS('      CALL U'//VNAMEG,IODINS)
        CALL ZMESS('      IFIRST=0',IODINS)
        CALL ZMESS('      IF (IFLAG..EQ..1) THEN',IODINS)
        CALL ZCHOUT('      DO 90 L=1,',IODINS)
        CALL ZPTINT(MCIRCG,1,IODINS)
        CALL PUTCH(10,IODINS)
        CALL ZMESS(' 90   ICIRCL(L)=0',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      IF (NREQ..GT..0) THEN',IODINS)
        CALL ZMESS('      IF (IFLAG..EQ..1) THEN',IODINS)
        CALL ZMESS('      DO 110 L=NREQ,1,-1',IODINS)
        CALL ZMESS('      IF(KVAL(L)..EQ..LPRE..AND..'//
     +             'ISEG(L)..EQ..NSEG)THEN',IODINS)
        CALL ZMESS('      CALL V'//VNAMEG//'(-1,''TRACE=     '')',
     +              IODINS)
        CALL ZCHOUT('      ICONST=IPT+',IODINS)
        CALL ZPTINT(MCIRCG-1,1,IODINS)
        CALL ZMESS('-JVAL(L)',IODINS)
        CALL ZMESS('      DO 100 K=1,JVAL(L)',IODINS)
        CALL ZCHOUT(' 100  CALL V'//VNAMEG//'(ICIRCL(MOD(ICONST+K,',
     +             IODINS)
        CALL ZPTINT(MCIRCG,1,IODINS)
        CALL ZMESS(')+1),''TRACE(PRE)='')',IODINS)
        CALL ZCHOUT('      IPT=MOD(IPT,',IODINS)
        CALL ZPTINT(MCIRCG,1,IODINS)
        CALL ZMESS(')+1',IODINS)
        CALL ZMESS('      ICIRCL(IPT)=NSEG',IODINS)
        CALL ZMESS('      CALL V'//VNAMEG//'(NSEG,''TRACE(PRE)='')',
     +              IODINS)
        CALL ZMESS('      CALL V'//VNAMEG//'(-1,''TRACE(PRE)='')',
     +              IODINS)
        CALL ZMESS('      GO TO 120',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('  110 CONTINUE',IODINS)
        CALL ZCHOUT('      IPT=MOD(IPT,',IODINS)
        CALL ZPTINT(MCIRCG,1,IODINS)
        CALL ZMESS(')+1',IODINS)
        CALL ZMESS('      ICIRCL(IPT)=NSEG',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('  120 ITHIS=0',IODINS)
        CALL ZMESS('      DO 130 L=1,NREQ',IODINS)
        CALL ZMESS('      IF (KVAL(L)..EQ..LPOST..AND..ISEG(L)..EQ..',
     +              IODINS)
        CALL ZMESS('     + NSEG..AND..JVAL(L)..GT..ICOUNT) THEN',IODINS)
        CALL ZMESS('      ICOUNT=JVAL(L)+1',IODINS)
        CALL ZMESS('      ELSEIF(KVAL(L)..EQ..LRANGE..AND..ISEG(L)',
     +             IODINS)
        CALL ZMESS('     + ..LE..NSEG..AND..JVAL(L)..GE..NSEG)THEN',
     +             IODINS)
        CALL ZMESS('      ITHIS=1',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('  130 CONTINUE',IODINS)
        CALL ZMESS('      IF (ICOUNT..GT..0) THEN',IODINS)
        CALL ZMESS('      ITHIS=1',IODINS)
        CALL ZMESS('      ICOUNT=ICOUNT-1',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      IF (ITHIS..EQ..1) CALL V'//VNAMEG//'(NSEG,'//
     +              '''TRACE=     '')',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      RETURN',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W T I N S   -   Insert trace input routine instrumentation
C
 
        SUBROUTINE WTINS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Filenames
        COMMON/ANFNAM/IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        CHARACTER*81 IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
        SAVE /ANFNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
*$AS$ (TRACEG)
        CALL ZMESS('      SUBROUTINE U'//VNAMEG,IODINS)
        CALL TCOMNS
        IF (.NOT.TIEG) THEN
            CALL ZMESS('      CHARACTER IOP',IODINS)
        ELSE
            CALL ZMESS('      INTEGER BUFF(134),IOP,JUNK',IODINS)
            CALL ZMESS('      INTEGER GETLIN,CTOI',IODINS)
            CALL ZMESS('      INTEGER OPEN,CREATE',IODINS)
        END IF
        CALL WFN2(ITRAFN,'ITRAFN',OTRAFN,'OTRAFN')
        CALL ZCHOUT('      DATA INTRA/',IODINS)
        CALL ZPTINT(INTRAG,1,IODINS)
        CALL ZMESS('/',IODINS)
        CALL ZCHOUT('      ITTRA=',IODINS)
        CALL ZPTINT(ITTRAG,1,IODINS)
        CALL PUTCH(10,IODINS)
        CALL ZMESS('      IFLAG=0',IODINS)
        CALL ZMESS('      LPRE=1',IODINS)
        CALL ZMESS('      LPOST=2',IODINS)
        CALL ZMESS('      LRANGE=3',IODINS)
        CALL ZMESS('      NREQ=0',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CALL ZINIT',IODINS)
            IF (ITRAFN.EQ.'''') THEN
                CALL ZMESS('      CALL ZMESS(''Input trace input '''//
     +                      'filename'',1)',IODINS)
                CALL ZMESS('      JUNK=GETLIN(ITRAFN,0)',IODINS)
            END IF
            IF (ITRAFN.NE.' ') THEN
                CALL ZMESS('      INTRA=OPEN(ITRAFN,0)',IODINS)
                CALL ZMESS('      IF (INTRA..EQ..-1) CALL ERROR('//
     +                      '''NO TRACE INPUT'')',IODINS)
            END IF
            IF (OTRAFN.EQ.'''') THEN
                CALL ZMESS('      CALL ZMESS(''Input trace output '//
     +                      'filename'',1)',IODINS)
                CALL ZMESS('      JUNK=GETLIN(OTRAFN,0)',IODINS)
            END IF
            IF (OTRAFN.NE.' ') THEN
                CALL ZMESS('      ITTRA=CREATE(OTRAFN,1)',IODINS)
                CALL ZMESS('      IF (ITTRA..EQ..-1) CALL ERROR('//
     +                      '''NO TRACE OUTPUT'')',IODINS)
            END IF
            CALL ZMESS('      CALL ZMESS(''TRACE OUTPUT REQUESTS'','//
     +                  'ITTRA)',IODINS)
            CALL ZMESS(' 100  IF (GETLIN(BUFF,INTRA)..EQ..-100) GOTO '//
     +                  '120',IODINS)
            CALL ZMESS('      JUNK=1',IODINS)
            CALL ZMESS('      MSEG=CTOI(BUFF,JUNK)',IODINS)
            CALL ZMESS('      IF (MSEG..EQ..0) GOTO 120',IODINS)
            CALL ZMESS('      IOP=BUFF(JUNK)',IODINS)
            CALL ZMESS('      JUNK=JUNK+1',IODINS)
            CALL ZMESS('      NVAL=CTOI(BUFF,JUNK)',IODINS)
            CALL ZMESS('      CALL ZCHOUT(''TRACE='',ITTRA)',IODINS)
            CALL ZMESS('      CALL PUTLIN(BUFF,ITTRA)',IODINS)
        ELSE
            IF (ITRAFN.EQ.'''') THEN
                CALL ZMESS('      PRINT *,''Trace input file?''',
     +                      IODINS)
                CALL ZMESS('      READ (*,''(A 81)'') ITRAFN',
     +                      IODINS)
            END IF
            IF (ITRAFN.NE.' ') THEN
                CALL ZMESS('      OPEN(INTRA,FILE=ITRAFN,STATUS='//
     +                      '''OLD'')',IODINS)
                CALL ZMESS('      REWIND(INTRA,ERR=125)',IODINS)
                CALL ZMESS('  125 CONTINUE',IODINS)
            END IF
            IF (OTRAFN.EQ.'''') THEN
                CALL ZMESS('      PRINT *,''Trace output file?''',
     +                      IODINS)
                CALL ZMESS('      READ (*,''(A 81)'') OTRAFN',
     +                      IODINS)
            END IF
            IF (OTRAFN.NE.' ') THEN
                CALL ZMESS('      OPEN(ITTRA,FILE=OTRAFN,STATUS='//
     +                      '''UNKNOWN'')',IODINS)
                CALL ZMESS('      REWIND(ITTRA,ERR=130)',IODINS)
                CALL ZMESS('  130 CONTINUE',IODINS)
            END IF
            CALL ZMESS('      WRITE (ITTRA,140)',IODINS)
            CALL ZMESS('  140 FORMAT (''1'',2X,''TRACE OUTPUT REQU'//
     +                  'ESTS'')',IODINS)
            CALL ZMESS('  100 READ (INTRA,150,END=120) MSEG,IOP,NVAL',
     +                  IODINS)
            CALL ZMESS('      IF (MSEG..EQ..0) GO TO 120',IODINS)
            CALL ZMESS('      WRITE (ITTRA,160)''TRACE='',MSEG,IOP,N'//
     +                  'VAL',IODINS)
        END IF
        CALL ZMESS('      IF(MSEG..GT..0..AND..NVAL..GT..0)THEN',IODINS)
        CALL ZCHOUT('      IF (NREQ..LT..',IODINS)
        CALL ZPTINT(MTREQG,1,IODINS)
        CALL ZMESS(') THEN',IODINS)
        CALL ZMESS('      NREQ=NREQ+1',IODINS)
        CALL ZMESS('      ISEG(NREQ)=MSEG',IODINS)
        CALL ZMESS('      JVAL(NREQ)=NVAL',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      IF(IOP..EQ..45)THEN',IODINS)
        ELSE
            CALL ZMESS('      IF (IOP..EQ..''-'') THEN',IODINS)
        END IF
        CALL ZMESS('      KVAL(NREQ)=LPRE',IODINS)
        CALL ZMESS('      IFLAG=1',IODINS)
        CALL ZCHOUT('      IF (JVAL(NREQ)..GT..',IODINS)
        CALL ZPTINT(MCIRCG,1,IODINS)
        CALL ZCHOUT(') JVAL(NREQ)=',IODINS)
        CALL ZPTINT(MCIRCG,1,IODINS)
        CALL PUTCH(10,IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      ELSEIF(IOP..EQ..43)THEN',IODINS)
        ELSE
            CALL ZMESS('      ELSEIF (IOP..EQ..''+'') THEN',IODINS)
        END IF
        CALL ZMESS('      KVAL(NREQ)=LPOST',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      ELSEIF(IOP..EQ..44)THEN',IODINS)
        ELSE
            CALL ZMESS('      ELSEIF (IOP..EQ..'','') THEN',IODINS)
        END IF
        CALL ZMESS('      KVAL(NREQ)=LRANGE',IODINS)
        CALL ZMESS('      ELSE',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CALL REMARK(''TRACE SYNTAX ERROR'')',
     +                  IODINS)
        ELSE
            CALL ZMESS('      WRITE (ITTRA,170)',IODINS)
        END IF
        CALL ZMESS('      NREQ=NREQ-1',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      ELSE',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CALL REMARK(''TOO MANY TRACE REQUESTS'')'
     +                  ,IODINS)
        ELSE
            CALL ZMESS('      WRITE (ITTRA,180)',IODINS)
        END IF
        CALL ZMESS('      GOTO 120',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      ELSE',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CALL REMARK(''TRACE SYNTAX ERROR'')',
     +                  IODINS)
        ELSE
            CALL ZMESS('      WRITE (ITTRA,170)',IODINS)
        END IF
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      GOTO 100',IODINS)
        IF (TIEG) THEN
            CALL ZMESS(' 110  CALL REMARK(''TRACE SYNTAX ERROR'')',
     +                  IODINS)
        ELSE
            CALL ZMESS(' 110  WRITE (ITTRA,170)',IODINS)
        END IF
        CALL ZMESS('      GOTO 100',IODINS)
        IF (TIEG) THEN
            CALL ZMESS(' 120  CALL CLOSE(INTRA)',IODINS)
C Output dummy routine to replace user's ZINIT
            CALL ZMESS('      END',IODINS)
            CALL ZMESS('      SUBROUTINE X'//VNAMEG,IODINS)
        ELSE
            CALL ZMESS(' 120  CLOSE(INTRA,ERR=121)',IODINS)
            CALL ZMESS(' 121  CONTINUE',IODINS)
            CALL ZMESS('  150 FORMAT (I4,A1,I4)',IODINS)
            CALL ZMESS('  160 FORMAT (3X,A6,I4,A1,I4)',IODINS)
            CALL ZMESS('  170 FORMAT (1X,''**TRACE REQUEST '//
     +                  'UNRECOGNIZABLE'')',IODINS)
            CALL OUTTXT('  180 FORMAT (1X,''**ONLY FIRST ',IODINS)
            CALL ZPTINT(MTREQG,1,IODINS)
            CALL ZMESS(' TRACE REQUESTS ACCEPTED'')',IODINS)
        END IF
        CALL ZMESS('      END',IODINS)
 
        END
C ----------------------------------------------------------------------
C
C       W T O U T S   -   Insert trace output routine instrumentation
C
 
        SUBROUTINE WTOUTS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
*$AS$ (TRACEG)
        CALL ZMESS('      SUBROUTINE V'//VNAMEG//'(NSEG,ITITLE)',
     +              IODINS)
        CALL ZMESS('      CHARACTER*11 ITITLE',IODINS)
        CALL ZMESS('      SAVE IBUFF,LAST,NBUFF,NREP',IODINS)
        CALL ZMESS('      INTEGER IBUFF(11)',IODINS)
        CALL TCOMNS
        CALL ZMESS('      DATA LAST,NBUFF,NREP/0,0,-1/',IODINS)
        CALL ZMESS('      IF (NSEG..GT..0) THEN',IODINS)
        CALL ZMESS('      IF (NSEG..EQ..LAST..AND..NBUFF..LE..9) THEN',
     +              IODINS)
        CALL ZMESS('      IF (NREP..EQ..-1) NBUFF=NBUFF+1',IODINS)
        CALL ZMESS('      NREP=NREP-1',IODINS)
        CALL ZMESS('      IBUFF(NBUFF)=NREP',IODINS)
        CALL ZMESS('      ELSE',IODINS)
        CALL ZMESS('      LAST=NSEG',IODINS)
        CALL ZMESS('      NBUFF=NBUFF+1',IODINS)
        CALL ZMESS('      IBUFF(NBUFF)=NSEG',IODINS)
        CALL ZMESS('      NREP=-1',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      IF (NBUFF..EQ..11..OR..(NSEG..LT..0..AND..'//
     +              'NBUFF..GT..0)) THEN',IODINS)
        IF (TIEG) THEN
            CALL ZMESS('      CALL ZCHOUT(ITITLE,ITTRA)',IODINS)
            CALL ZMESS('      DO 100 I=1,NBUFF',IODINS)
            CALL ZMESS(' 100  CALL ZPTINT(IBUFF(I),11,ITTRA)',IODINS)
            CALL ZMESS('      CALL PUTCH(10,ITTRA)',IODINS)
        ELSE
            CALL ZMESS('      WRITE (ITTRA,100) ITITLE,'//
     +                  '(IBUFF(I),I=1,NBUFF)',IODINS)
            CALL ZMESS('  100 FORMAT (1X,A11,11I6)',IODINS)
        END IF
        CALL ZMESS('      LAST=0',IODINS)
        CALL ZMESS('      NBUFF=0',IODINS)
        CALL ZMESS('      NREP=-1',IODINS)
        CALL ZMESS('      END IF',IODINS)
        CALL ZMESS('      END',IODINS)
 
        END
